Sparse canonical correlation analysis for neuroimaging (SCCAN) is a general purpose tool for “two-sided” multiple regression. This allows one to symmetrically compare one matrix of data to another and find linear relationships between them in a low-dimensional space. SCCAN derives from classic canonical correlation analysis and also relates to singular value decomposition. To handle data with \(p>>n\), SCCAN uses high-dimensional regularization methods common in \(\ell_1\) regression and spatial regularization to help ensure the biological plausibility of statistical maps in medical imaging. This problem is a difficult optimization (\(np\)-hard) and, to improve solution interpetability and stability, SCCAN allows one to to use prior knowledge to constrain the solution space.
Perhaps the best way to understand how to use SCCAN is by running example data.
We read in some neuroimaging and cognitive data below.
data(aal,package='ANTsR')
gfnl<-list.files(path=rootdir, pattern = glob2rx("pbac*mha"),
full.names = T,recursive = T)
ptrainimg<-as.matrix(antsImageRead(gfnl[2],2))
ptestimg<-as.matrix(antsImageRead(gfnl[1],2))
gfnl<-list.files(path=rootdir, pattern = "gmask.nii.gz",
full.names = T,recursive = T)
mask<-antsImageRead( gfnl[1], 3 )
afnl<-list.files(path=rootdir, pattern = "aal.nii.gz",
full.names = T,recursive = T)
aalimg<-antsImageRead( afnl[1], 3 )
f1<-list.files(path =rootdir, pattern = "pbac_train_cog.csv",
recursive=TRUE, full.names = TRUE, include.dirs=TRUE )
f2<-list.files(path = rootdir, pattern = "pbac_test_cog.csv",
recursive=TRUE, full.names = TRUE )
ptraincog<-read.csv(f1)
ptestcog<-read.csv(f2)
We already divided the dataset into two different groups - one for testing and one for training.
Use sccan to find brain regions relating to age. We impose a “cluster threshold” regularization to prevent isolated voxels from appearing in the solution. We will also compare the results in training with that in testing as a function of spareseness.
agemat<-matrix( ptraincog$age, ncol=1)
paramsearch<-c(1:10)/(-100.0)
paramsearchcorrs<-rep(0,length(paramsearch))
paramsearchpreds<-rep(0,length(paramsearch))
ct<-1
for ( sp in paramsearch ) {
ageresult<-sparseDecom2( inmatrix=list(ptrainimg,agemat), its=8, mycoption=1,
sparseness=c(sp,0.9), inmask=c(mask,NA),nvecs=2, cthresh=c(50,0))
# convert output images to matrix so we can validate in test data
ccamat<-imageListToMatrix( ageresult$eig1, mask )
agepred<-ptrainimg %*% t(ccamat)
paramsearchcorrs[ct]<-cor( agepred[,1], ptraincog$age )
agepred<-ptestimg %*% t(ccamat)
paramsearchpreds[ct]<-cor( agepred[,1], ptestcog$age )
ct<-ct+1
}
mydf<-data.frame( sparseness=paramsearch, trainCorrs=paramsearchcorrs,
testCorrs=paramsearchpreds )
mdl1<-lm( trainCorrs ~ stats::poly(sparseness,4), data=mydf )
mdl2<-lm( testCorrs ~ stats::poly(sparseness,4) , data=mydf )
visreg(mdl1)
visreg(mdl2)
Use SCCAN to find brain regions relating to language. We initialize with left hemisphere regions.
langmat<-cbind( ptraincog$speech_adj, ptraincog$writing_adj,
ptraincog$semantic_adj, ptraincog$reading_adj,
ptraincog$naming_adj )
colnames(langmat)<-c("speech","writing","semantic","reading","naming")
langmat2<-cbind( ptestcog$speech_adj, ptestcog$writing_adj,
ptestcog$semantic_adj, ptestcog$reading_adj,
ptestcog$naming_adj )
colnames(langmat2)<-colnames(langmat)
labels<-c(13,81,39,79)
print(aal$label_name[labels])
## [1] Frontal_Inf_Tri_L Temporal_Sup_L ParaHippocampal_L Heschl_L
## 116 Levels: Amygdala_L Amygdala_R Angular_L Angular_R ... Vermis_9
initmat<-matrix( rep(0,sum(mask==1)*length(labels)), nrow=length(labels) )
# fill the matrix with the aal region locations
for ( i in 1:length(labels) ) {
vec<-( aalimg[ mask == 1 ] == labels[i] )
vec[ vec > 0]<-vec[ vec > 0]+rnorm(sum(vec>0))*0.01
initmat[i,]<-vec
}
ccainit<-initializeEigenanatomy( initmat, mask )
pwsearch<-c(50,25,10)
langfn<-rep("",length(pwsearch))
langfn2<-rep("",length(pwsearch))
ct<-1
for ( pw in pwsearch ) {
langresult<-sparseDecom2( inmatrix=list(ptrainimg,langmat), its=15, mycoption=1,
sparseness=c(sp,-0.3), inmask=c(mask,NA),nvecs=length(labels), cthresh=c(125,0),
initializationList=ccainit$initlist, priorWeight=pw/100, smooth=0.0, ell1=-10 )
ccamat<-imageListToMatrix( langresult$eig1, mask )
langpred<-ptrainimg %*% t(ccamat)
colnames(langpred)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred<-langmat %*% data.matrix( langresult$eig2 )
bestpred<-which.max(abs(diag(cor(langpred,cogpred))))
mydf<-data.frame( cogpred, langpred )
myform<-as.formula( paste("Variate00",bestpred-1,"~GM1+GM2+GM3+GM4",sep='') )
mdltrain<-lm( myform, data=mydf )
langpred<-ptestimg %*% t(ccamat)
colnames(langpred)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred<-langmat2 %*% data.matrix( langresult$eig2 )
mydf<-data.frame( cogpred, langpred )
print(cor.test( mydf[,bestpred] ,predict(mdltrain,newdata=mydf)))
for ( i in 1:length(labels) )
print( paste( "Dice: ",aal$label_name[labels[i]],
sum( abs(ccamat[i,]) > 0 & initmat[i,] > 0 ) /
sum( abs(ccamat[i,]) > 0 | initmat[i,] > 0 ) ) )
for ( x in langresult$eig1 ) {
x[ mask == 1 ]<-abs( x[ mask == 1 ] )
x[ mask == 1 ]<-x[ mask == 1 ]/max( x[ mask == 1 ] )
}
mycolors<-c("red","green","blue","yellow")
langfn[ct]<-paste(rootdir,'/figures/langSCCANRegression',pw,'.jpg',sep='')
langfn2[ct]<-paste(rootdir,'/figures/langSCCANRegression',pw,'.png',sep='')
plotANTsImage( mask, functional=(langresult$eig1), threshold='0.25x1',
slices="12x50x1",color=mycolors,outname=langfn[ct] )
# cnt<-getCentroids( ntwkimage, clustparam = 100 )
brain<-renderSurfaceFunction( surfimg =list( aalimg ) , alphasurf=0.1 ,
funcimg=langresult$eig1, smoothsval=1.5, smoothfval=0, mycol=mycolors )
id<-par3d("userMatrix")
rid<-rotate3d( id , -pi/2, 1, 0, 0 )
rid2<-rotate3d( id , pi/2, 0, 0, 1 )
rid3<-rotate3d( id , -pi/2, 0, 0, 1 )
par3d(userMatrix = id )
dd<-make3ViewPNG( rid, id, rid2, paste(rootdir,'/figures/langSCCANRegression',pw,sep='') )
par3d(userMatrix = id )
ct<-ct+1
}
##
## Pearson's product-moment correlation
##
## data: mydf[, bestpred] and predict(mdltrain, newdata = mydf)
## t = 2.687, df = 81, p-value = 0.008751
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.0750 0.4726
## sample estimates:
## cor
## 0.2861
##
## [1] "Dice: Frontal_Inf_Tri_L 0.997280761386812"
## [1] "Dice: Temporal_Sup_L 0.989698307579102"
## [1] "Dice: ParaHippocampal_L 1"
## [1] "Dice: Heschl_L 0"
## Warning: the condition has length > 1 and only the first element will be used
## Warning: 'x' is NULL so the result will be NULL
## Warning: the condition has length > 1 and only the first element will be used
##
## Pearson's product-moment correlation
##
## data: mydf[, bestpred] and predict(mdltrain, newdata = mydf)
## t = 4.968, df = 81, p-value = 3.704e-06
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.2987 0.6330
## sample estimates:
## cor
## 0.4832
##
## [1] "Dice: Frontal_Inf_Tri_L 0.174365376612568"
## [1] "Dice: Temporal_Sup_L 0.973509933774834"
## [1] "Dice: ParaHippocampal_L 0.940677966101695"
## [1] "Dice: Heschl_L 0.437956204379562"
## Warning: the condition has length > 1 and only the first element will be used
## Warning: 'x' is NULL so the result will be NULL
## Warning: the condition has length > 1 and only the first element will be used
##
## Pearson's product-moment correlation
##
## data: mydf[, bestpred] and predict(mdltrain, newdata = mydf)
## t = 5.685, df = 81, p-value = 2.001e-07
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.3598 0.6723
## sample estimates:
## cor
## 0.534
##
## [1] "Dice: Frontal_Inf_Tri_L 0.0787226141849239"
## [1] "Dice: Temporal_Sup_L 0"
## [1] "Dice: ParaHippocampal_L 0.110299488677867"
## [1] "Dice: Heschl_L 0"
## Warning: the condition has length > 1 and only the first element will be used
## Warning: 'x' is NULL so the result will be NULL
## Warning: the condition has length > 1 and only the first element will be used
Strong prior
Medium prior
Weak prior
The best results are initialized by the prior but, in the end, drift away from that initialization. Where in the brain do the solution vectors end up?
reportAnatomy<-function( eigIn, maskIn, wt=0.3 )
{
data('aal',package='ANTsR')
ccaanat<-list()
for ( img in eigIn ) {
nzind<-abs(img[ maskIn == 1 ]) > 0
aalvals<-aalimg[ maskIn == 1 ][ nzind ]
ccaanat<-lappend( ccaanat, aalvals )
}
ccaanat<-unlist( ccaanat )
anatcount<-hist(ccaanat,breaks=0:100, plot = F)$count
anatcount[ anatcount < wt*max(anatcount) ]<-0
anatcount<-which( anatcount > 0 )
return( toString(aal$label_name[anatcount] ) )
}
ccaaal<-reportAnatomy( langresult$eig1 , mask )
The SCCAN predictors include: Frontal_Inf_Tri_L, Precuneus_R, Temporal_Sup_R, Temporal_Mid_R, Temporal_Inf_R.
How good were our original hypothetical regions as predictors?
Recalling: CCA maximizes \(PearsonCorrelation( XW^T, ZY^T )\), we can study matrix \(Y\) which contrasts or combines columns of the cognition/design matrix.
rownames(langresult$eig2)<-colnames(langmat)
temp<-(langresult$eig2)
temp[ abs(langresult$eig2) < 0.03 ]<-0
pheatmap(temp)
Often, we want to control for the presence of nuisance variables. As usual, there are several options: (1) control after you do dimensionality reduction; (2) orthogonalize the predictors. (3) Use alternative SCCAN formulations (e.g. set mycoption to 0 or 2). Let’s try the first 2 choices as they are more traditional.
# 1. control for age and mmse after the dimensionality reduction
langresult<-sparseDecom2( inmatrix=list(ptrainimg,langmat), its=15, mycoption=1,
sparseness=c(sp,-0.9), inmask=c(mask,NA),nvecs=length(labels), cthresh=c(50,0),
initializationList=ccainit$initlist, priorWeight=pw/100, smooth=0.0, ell1=-10 )
ccamat<-imageListToMatrix( langresult$eig1, mask )
langpred<-ptrainimg %*% t(ccamat)
colnames(langpred)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred<-langmat %*% data.matrix( langresult$eig2 )
bestpred<-which.max(abs(diag(cor(langpred,cogpred))))
mydf<-data.frame( cogpred, langpred, mmse=ptraincog$mmse,age=ptraincog$age)
myform<-as.formula( paste("Variate00",bestpred-1,
"~GM1+GM2+GM3+GM4+mmse+age",sep='') )
mdltrain<-lm( myform, data=mydf )
print(summary(mdltrain))
##
## Call:
## lm(formula = myform, data = mydf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.2665 -0.0329 0.0149 0.0546 0.1134
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6.01e-01 2.26e-01 -2.66 0.0094 **
## GM1 -3.23e+00 5.60e+00 -0.58 0.5660
## GM2 -1.57e+01 7.20e+00 -2.19 0.0315 *
## GM3 -1.28e+00 2.12e+00 -0.61 0.5455
## GM4 -4.91e+00 2.62e+00 -1.87 0.0645 .
## mmse 7.14e-03 1.52e-03 4.71 1e-05 ***
## age -2.35e-04 1.19e-03 -0.20 0.8439
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.0835 on 82 degrees of freedom
## Multiple R-squared: 0.59, Adjusted R-squared: 0.559
## F-statistic: 19.6 on 6 and 82 DF, p-value: 4.53e-14
langpred2<-ptestimg %*% t(ccamat)
colnames(langpred2)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred2<-langmat2 %*% data.matrix( langresult$eig2 )
mydf<-data.frame( cogpred2, langpred2,mmse=ptestcog$mmse,age=ptestcog$age )
print(cor.test( mydf[,bestpred] ,predict(mdltrain,newdata=mydf)))
##
## Pearson's product-moment correlation
##
## data: mydf[, bestpred] and predict(mdltrain, newdata = mydf)
## t = 7.338, df = 81, p-value = 1.491e-10
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.4819 0.7459
## sample estimates:
## cor
## 0.6319
Now, the second option.
# 2. orthogonalize the matrices against mmse and education
rlangmat<-residuals(lm(langmat~ptraincog$mmse+ptraincog$age))
rptrainimg<-residuals(lm(ptrainimg~ptraincog$mmse+ptraincog$age))
langresult<-sparseDecom2( inmatrix=list(rptrainimg,rlangmat), its=15, mycoption=1,
sparseness=c(sp,-0.9), inmask=c(mask,NA),nvecs=length(labels), cthresh=c(50,0),
initializationList=ccainit$initlist, priorWeight=pw/100, smooth=0.0, ell1=-10 )
ccamat<-imageListToMatrix( langresult$eig1, mask )
langpred<-ptrainimg %*% t(ccamat)
colnames(langpred)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred<-langmat %*% data.matrix( langresult$eig2 )
bestpred<-which.max(abs(diag(cor(langpred,cogpred))))
mydf<-data.frame( cogpred, langpred, mmse=ptraincog$mmse,age=ptraincog$age)
myform<-as.formula( paste("Variate00",bestpred-1,
"~GM1+GM2+GM3+GM4+mmse+age",sep='') )
mdltrain<-lm( myform, data=mydf )
print(summary(mdltrain))
##
## Call:
## lm(formula = myform, data = mydf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.2469 -0.0718 0.0067 0.0618 0.1984
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.23981 0.17125 -7.24 2.2e-10 ***
## GM1 1.59695 1.40223 1.14 0.258
## GM2 18.30504 2.57894 7.10 4.1e-10 ***
## GM3 -3.43770 1.68915 -2.04 0.045 *
## GM4 1.46179 1.91991 0.76 0.449
## mmse 0.00954 0.00120 7.92 1.0e-11 ***
## age 0.00210 0.00110 1.91 0.060 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.0825 on 82 degrees of freedom
## Multiple R-squared: 0.731, Adjusted R-squared: 0.711
## F-statistic: 37.1 on 6 and 82 DF, p-value: <2e-16
langpred2<-ptestimg %*% t(ccamat)
colnames(langpred2)<-paste("GM",c(1:ncol(langpred)),sep='')
cogpred2<-langmat2 %*% data.matrix( langresult$eig2 )
mydf<-data.frame( cogpred2, langpred2,mmse=ptestcog$mmse,age=ptestcog$age )
print(cor.test( mydf[,bestpred] ,predict(mdltrain,newdata=mydf)))
##
## Pearson's product-moment correlation
##
## data: mydf[, bestpred] and predict(mdltrain, newdata = mydf)
## t = 7.599, df = 81, p-value = 4.601e-11
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.4989 0.7557
## sample estimates:
## cor
## 0.6451
Try to predict all the demographic variability from the imaging data. We use mycoption 0 to try to reduce correlation in low-dimensional space. This enforces a new SCCAN constraint (not previously reported).
nv<-11
nfn<-rep("",nv)
cognames<-rep("",nv)
cogmat<-data.matrix(ptraincog)
rcogmat<-residuals( lm( data.matrix(ptraincog) ~ ptraincog$mmse + ptraincog$age ) )
rptrainimg<-residuals( lm( ptrainimg ~ ptraincog$mmse ) )
batt<-sparseDecom2( inmatrix=list(rptrainimg,rcogmat), its=15,
sparseness=c(0.02, -0.05), inmask=c(mask,NA), nvecs=nv, cthresh=c(100,0),
smooth=0.0, ell1=-10, mycoption=1 )
ccamat<-imageListToMatrix( batt$eig1, mask )
gvars<-paste("GM",c(1:nrow(ccamat)),sep='',collapse='+')
Now let’s use our previously developed reporting capabilities.
render<-TRUE
for ( bestpred in 1:nrow(ccamat)) {
battpred<-ptrainimg %*% t(ccamat)
colnames(battpred)<-paste("GM",c(1:ncol(battpred)),sep='')
cogpred<-( rcogmat %*% data.matrix( batt$eig2 ) )[,bestpred]
mydf<-data.frame( cogpred, battpred )
myform<-as.formula( paste("cogpred~",gvars,sep='') )
mdltrain<-lm( myform, data=mydf )
mdlinterp<-bigLMStats( mdltrain )
battpred<-ptestimg %*% t(ccamat)
colnames(battpred)<-paste("GM",c(1:ncol(battpred)),sep='')
cogpred<-(data.matrix(ptestcog) %*% data.matrix( batt$eig2 ))[,bestpred]
mydf<-data.frame( cogpred, battpred )
cat(paste("Eig",bestpred,"is related to:\n"))
mycog<-colnames(ptraincog)[ abs(batt$eig2[,bestpred]) > 0 ]
cat( mycog )
cat("\nwith weights\n")
cat( abs(batt$eig2[,bestpred])[ abs(batt$eig2[,bestpred]) > 0 ])
cat(paste("\nwith predictive correlation:",
cor( cogpred,predict(mdltrain,newdata=mydf))))
cat("\nAnatomy:")
for ( x in which.min(p.adjust(mdlinterp$beta.pval)) ) {
myanat<-reportAnatomy( list( batt$eig1[[x]]) , mask , 0.5 )
cat(myanat)
if ( render ) {
vizimg<-antsImageClone( batt$eig1[[x]] )
ImageMath(3,vizimg,'abs',vizimg)
brain<-renderSurfaceFunction( surfimg =list( aalimg ) , alphasurf=0.1 ,
funcimg=list(vizimg), smoothsval = 1.5 )
id<-par3d("userMatrix")
rid<-rotate3d( id , -pi/2, 1, 0, 0 )
rid2<-rotate3d( id , pi/2, 0, 0, 1 )
rid3<-rotate3d( id , -pi/2, 0, 0, 1 )
par3d(userMatrix = id )
ofn<-paste(rootdir,'/figures/battery',bestpred,sep='')
nfn[ bestpred ]<-paste(ofn,'.png',sep='')
cognames[ bestpred ]<-paste(mycog,collapse='+')
dd<-make3ViewPNG( rid, id, rid2, ofn )
par3d(userMatrix = id )
}
cat("\n")
}
cat("\n")
}
## Eig 1 is related to:
## fluency_adj JOLO_adj
## with weights
## 0.03572 0.1018
## with predictive correlation: 0.140354896318403
## Anatomy:Frontal_Mid_R, Cingulum_Mid_R, Occipital_Mid_L, Temporal_Mid_L
##
## Eig 2 is related to:
## naming_adj
## with weights
## 0.1066
## with predictive correlation: 0.468017964104961
## Anatomy:Fusiform_R, Temporal_Inf_R
##
## Eig 3 is related to:
## rey_copy_adj
## with weights
## 0.1066
## with predictive correlation: 0.397046334604034
## Anatomy:Occipital_Mid_L, Fusiform_L, Parietal_Inf_L, Temporal_Mid_L, Temporal_Inf_L
##
## Eig 4 is related to:
## recog_adj
## with weights
## 0.1066
## with predictive correlation: 0.128152873945102
## Anatomy:Precentral_L, ParaHippocampal_L, ParaHippocampal_R, Temporal_Mid_L, Temporal_Inf_L
##
## Eig 5 is related to:
## socialcomportment
## with weights
## 0.1066
## with predictive correlation: 0.266423882213593
## Anatomy:Rectus_L, Rectus_R, Insula_R, Caudate_L, Caudate_R, Putamen_L, Temporal_Inf_L
##
## Eig 6 is related to:
## rey_recall_adj
## with weights
## 0.1066
## with predictive correlation: 0.170953680680854
## Anatomy:Frontal_Mid_L, Frontal_Mid_R, Insula_L, ParaHippocampal_R, Calcarine_R, Occipital_Mid_L, Fusiform_L, Temporal_Sup_L, Temporal_Mid_L
##
## Eig 7 is related to:
## speech_adj
## with weights
## 0.1066
## with predictive correlation: -0.103862207243451
## Anatomy:Frontal_Mid_Orb_R, Frontal_Inf_Tri_R, Frontal_Inf_Orb_R, Temporal_Mid_R
##
## Eig 8 is related to:
## fluency_adj
## with weights
## 0.1066
## with predictive correlation: 0.00347449131443053
## Anatomy:Cuneus_R, Occipital_Sup_R, Occipital_Mid_R, Precuneus_R
##
## Eig 9 is related to:
## apathy
## with weights
## 0.1066
## with predictive correlation: 0.39854430328004
## Anatomy:Temporal_Sup_R
##
## Eig 10 is related to:
## delay_free_adj
## with weights
## 0.1066
## with predictive correlation: -0.0795914746536028
## Anatomy:Frontal_Mid_R, Cingulum_Mid_R, Occipital_Mid_L, Temporal_Mid_L
##
## Eig 11 is related to:
## rey_copy_adj
## with weights
## 0.1066
## with predictive correlation: 0.397046334604034
## Anatomy:Occipital_Mid_L, Fusiform_L, Parietal_Inf_L, Temporal_Mid_L, Temporal_Inf_L
Anatomy related with fluency_adj+JOLO_adj
Anatomy related with naming_adj
Anatomy related with rey_copy_adj
Anatomy related with recog_adj
Anatomy related with socialcomportment
Anatomy related with rey_recall_adj
Anatomy related with speech_adj
Anatomy related with fluency_adj
Anatomy related with apathy
Anatomy related with delay_free_adj
Anatomy related with rey_copy_adj
Can the neuroimaging data predict the full cognitive battery?
# use cca to transform cortical signal to the cognitive battery
batt2<-sparseDecom2( inmatrix=list(rptrainimg,rcogmat), its=15,
sparseness=c(0.02, -0.9), inmask=c(mask,NA), nvecs=nv, cthresh=c(100,0),
smooth=0.0, ell1=-10, mycoption=1 )
ccamat<-imageListToMatrix( batt2$eig1, mask )
predictedBattery<-data.frame( vox=ptrainimg %*% t(ccamat) %*% t(batt2$eig2) )
print(diag(cor(cogmat,predictedBattery)))
## [1] 0.04707 0.18585 0.12448 0.08079 0.05763 0.01225 0.51996 0.44400
## [9] 0.46830 0.38188 0.39129 0.48106 0.37810 0.52096 0.50097 0.10328
## [17] 0.39308 0.42130 0.43802 0.19642 0.32807
predictedBattery<-data.frame( vox=ptestimg %*% t(ccamat) %*% t(batt2$eig2) )
print(diag(cor(data.matrix(ptestcog),predictedBattery)))
## [1] -0.22095 0.07252 -0.04368 -0.10955 -0.01810 -0.04819 0.39080
## [8] 0.08382 0.14221 0.08864 0.36601 0.50798 0.31882 0.41619
## [15] 0.34914 0.27937 0.27407 0.44326 0.10207 0.12704 0.37066
qv<-rep(NA,ncol(ptestcog) )
for ( i in 1:ncol(ptestcog) ) {
qv[i]<-cor.test(data.matrix(ptestcog)[,i],predictedBattery[,i])$p.value
ttl<-paste( colnames(ptestcog)[i],
cor(data.matrix(ptestcog)[,i],predictedBattery[,i]) )
mdl<-data.frame( realCog=data.matrix(ptestcog)[,i],
predCog=predictedBattery[,i] )
mylm<-lm( predCog ~ realCog , data=mdl )
visreg( mylm , main=ttl)
Sys.sleep(1)
}
qv[ is.na(qv) ]<-1
qv<-p.adjust(qv,method='BH')
The following univariate columns may be predicted using SCCAN multivariate mapping: naming_adj, semantic_adj, delay_free_adj, recog_adj, rey_recall_adj, JOLO_adj, rey_copy_adj, apathy, disinhibition, empathy.